home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / IFF / double_buffer next >
Encoding:
Text File  |  1992-01-24  |  3.5 KB  |  220 lines
  1. \ Fast Double Buffering
  2. \ Open a Screen with a backdrop window,
  3. \ Init two views and use them for buffering.
  4. \ Provide word to switch display/drawing surface.
  5. \
  6. \ Author: Phil Burk
  7. \ Copyright 1990 Phil Burk
  8. \
  9. \ 00001 PLB 9/23/91 Use DBUF-WINDOWS rastport
  10. \ 00002 PLB 1/24/92 Changed name of ERROR locals to ERROR?, so no conflict.
  11.  
  12. getmodule includes
  13. include? choose ju:random
  14. include? bitmap>screen ju:screen_support
  15.  
  16. ANEW TASK-Double_Buffer
  17.  
  18. variable DBUF-VIEW0
  19. variable DBUF-VIEW1
  20.  
  21. variable DBUF-BITMAP0
  22. variable DBUF-BITMAP1
  23.  
  24. variable DBUF-SCREEN
  25. variable DBUF-WINDOW
  26.  
  27. variable DBUF-RASTPORT
  28.  
  29. variable DBUF-CUR-BUF  \ 0 or 1 for currently DISPLAYED "buffer"
  30.  
  31. : DBUF.UNMAKE.VIEWS  ( -- )
  32.     dbuf-view0 @ ?dup
  33.     IF
  34.         free.view
  35.         dbuf-view0 off
  36.     THEN
  37. \
  38.     dbuf-view1 @ ?dup
  39.     IF
  40.         free.view
  41.         dbuf-view1 off
  42.     THEN
  43. ;
  44.  
  45. : DBUF.UNMAKE  ( -- close and free everything )
  46.     dbuf-window @ ?dup
  47.     IF    dup gr-curwindow @ =
  48.         IF
  49.             drop GR.CloseCurW
  50.         ELSE
  51.             gr.CloseWindow
  52.         THEN
  53.         dbuf-window off
  54.     THEN
  55. \
  56.     dbuf-screen @ ?dup
  57.     IF    CloseScreen()
  58.         dbuf-screen off
  59.     THEN
  60. \
  61.     dbuf-bitmap0 @ ?dup
  62.     IF    Free.Bitmap
  63.         dbuf-bitmap0 off
  64.     THEN
  65. \
  66.     dbuf-bitmap1 @ ?dup
  67.     IF    Free.Bitmap
  68.         dbuf-bitmap1 off
  69.     THEN
  70.  
  71.     dbuf.unmake.views
  72. ;
  73.  
  74.  
  75. : DBUF.MAKE0  { bdepth bwidth bheight camg | error? -- error? , first buffer }
  76.     dbuf.unmake
  77.     true -> error?
  78.     bdepth bwidth bheight
  79.     alloc.bitmap   ?dup
  80.     IF
  81.         dup dbuf-bitmap0 !
  82.         camg bitmap>screen  ?dup
  83.         IF
  84.             dup dbuf-screen !
  85.             screen>backwindow ?dup
  86.             IF
  87.                 dbuf-window !
  88.                 0 dbuf-cur-buf !
  89.                 dbuf-window @ s@ wd_rport dbuf-rastport ! \ 00001
  90.                 false -> error?
  91.             THEN
  92.         THEN
  93.     THEN
  94.     error? dup
  95.     IF dbuf.unmake
  96.     THEN
  97. ;
  98.  
  99. : DBUF.SELECT.BITMAP ( 0|1 -- bitmap )
  100.     IF
  101.         dbuf-bitmap1 @ dup 0=
  102.         IF
  103.             drop dbuf-bitmap0 @
  104.         THEN
  105.     ELSE dbuf-bitmap0 @
  106.     THEN
  107.     dup 0= abort" DBUF.SELECT.BITMAP - found no bitmap!"
  108. ;
  109.  
  110. : DBUF_DRAWING_BITMAP ( -- bitmap )
  111.     dbuf-cur-buf @ 1 xor dbuf.select.bitmap
  112.  
  113. ;
  114. : DBUF_SHOWING_BITMAP ( -- bitmap )
  115.     dbuf-cur-buf @ dbuf.select.bitmap
  116. ;
  117.  
  118. : DBUF.DRAWTO  ( 0|1 -- , draw to that bitmap )
  119.     dbuf.select.bitmap
  120.     dbuf-rastport @ link.bm>rp
  121.     dbuf-rastport @ >abs gr-currport !
  122. ;
  123.  
  124. : DBUF.DISPLAY ( 0|1 -- , display that view )
  125.     IF dbuf-view1 @
  126.     ELSE dbuf-view0 @
  127.     THEN
  128.     LoadView()
  129. ;
  130.  
  131. : DBUF.SWITCH  ( -- , switch between double buffers )
  132.     dbuf-cur-buf @
  133.     dup 1 xor dup dbuf-cur-buf !
  134.     dbuf.display
  135.     dbuf.drawto
  136. ;
  137.  
  138. : DBUF.MAKE.VIEW  ( bitmap -- view | 0 , use bitmap in screen, make view)
  139.     dbuf-screen @ .. sc_bitmap
  140.     copy.planes
  141.     dbuf-screen @ remake.screen
  142. \
  143. \ now make view for it
  144.     dbuf-screen @ screen>view
  145. ;
  146.  
  147. : DBUF.MAKE.VIEWS  ( -- error? , make views for both buffers )
  148.     dbuf.unmake.views
  149.     true  \ default error flag
  150.     dbuf-bitmap0 @ dbuf.make.view ?dup
  151.     IF    dbuf-view0 !
  152. \
  153.         dbuf-bitmap1 @ dbuf.make.view ?dup
  154.         IF    dbuf-view1 !
  155.             drop false \ return value
  156.         THEN
  157.     THEN
  158.     dup
  159.     IF dbuf.unmake.views
  160.     THEN
  161. ;
  162.  
  163. : DBUF.MAKE1  { bdepth bwidth bheight | error? -- error? , second buffer }
  164.     true -> error?
  165.     bdepth bwidth bheight
  166.     alloc.bitmap   ?dup
  167.     IF
  168.         dbuf-bitmap1 !
  169. \        alloc.rastport ?dup \ 00001
  170. \        IF  dbuf-rastport !
  171.             1 dbuf.drawto
  172.             dbuf.make.views -> error?
  173. \        THEN
  174.     THEN
  175. \
  176.     error? dup
  177.     IF dbuf.unmake
  178.     THEN
  179. ;
  180.  
  181. if.forgotten dbuf.unmake
  182.  
  183. 1 .IF
  184. \ test double buffering
  185. : T1
  186.     graphics?
  187.     4 320 200 0 dbuf.make0
  188. ;
  189. : T2
  190.     4 320 200 dbuf.make1
  191. ;
  192.  
  193. : TDRAW ( -- draw )
  194.     gr.clear
  195.     50 50 gr.move
  196.     60 0
  197.     DO 16 choose gr.color!
  198.         320 choose 200 choose gr.draw
  199.     LOOP
  200. ;
  201.  
  202. : TLOOP ( -- )
  203.     dbuf.switch
  204.     BEGIN
  205.         tdraw  dbuf.switch
  206.         ?terminal
  207.     UNTIL
  208. ;
  209.  
  210. : TEST
  211.     t1 abort" t1 failed"
  212.     t2 abort" t2 failed"
  213.     tloop
  214.     dbuf.unmake
  215. ;
  216.  
  217.  
  218. .THEN
  219.  
  220.